home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
novtli
/
novtli.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
18KB
|
562 lines
unit Novtli;
{ Install this component using Options|Install Compenents.
The function of this module is to provide Delphi with a
component capable of interfacing with Novell's Transport
Layer Interface (TLI) providing IPX/SPX transport capabilities.
You must have a network card installed and the appropriate Netware
drivers to use this component. For example. An 3Com Ethernet card with
the 3c509 driver, lsl, ipxodi, nwipxspx.dll, tli_spx.dll, and tli_win.dll.
The code herein is released to the public domain under the condition
that it will not be used for commercial or "For Profit" ventures.
Written By: Gary T. Desrosiers
Date: May 25th, 1995.
Copyright: (R) Copyright by Gary T. Desrosiers, 1995. All Rights Reserved
UserID(s): 71062,2754
desrosi@pcnet.com
Description: Novell Transport Layer Interface (TLI) Component.
Properties: ServerName, Design time and runtime read/write.
(This option is mutually exclusive with 'Addr').
For servers, sets the name that the server will
be advertised as.
For clients, sets the name of the server to connect to.
This option causes a Service Advertising Protocol (SAP)
request to be issued on the network. You're network
must be capable of supporting SAP for ServerName to
be used. A Netware server or router/bridge capable of
servicing the QueryServices request must be present.
example;
NovTLI1.ServerName := 'MyServer';
Addr, Design time and runtime read/write.
(This property is mutually exclusive with 'ServerName')
Sets the physical network and node address' of
the server that this client will connect to.
The format of the address is:
xxxxxxxx/yyyyyyyyyyyy
where x is the hexadecimal network number and y is
the hexadecimal node number. Both addresses can be
obtained using the Netware command:
userlist /a
The network is defined by the Netware server and
the Node is defined as the MAC address of the
network card.
For example, if the server was running on my PC
where the network = 00000001 and the node =
0080C72E12D4, I would do the following:
NovTLI1.Addr := '00000001/0080C72E12D4';
Port, Design time and runtime read/write.
Client: port number that this client connects
to on the server. If you're using 'ServerName'
the client doesnt have to set this property. It
will be determined dynamically using SAP. (See
description under 'ServerName' property).
Server: sets the port number that this server will
listen on. You must always specify this for servers.
You can use any unique number you like.
example;
NovTLI1.Port := 31;
Text, Runtime read/write.
if set, sends the text to the partner.
if read, receives some text from the partner.
examples;
buffer := NovTLI1.Text; (* Receive data *)
NovTLI1.Text := 'This is a test'; (* Send Data *)
SocketNumber, Runtime read/write.
Unique number representing the client connection
This is set by the component after a connect call
and also after a server has issued a Accept;
ListenSocketNumber, Runtime read/write.
Unique number representing the server's connection.
This is set by the component after a Listen;
Methods: Connect - Connects to the remote (or local) system
specified in the Addr and Port properties or to the
server specified in 'ServerName'.
example;
NovTLI1.Connect; (* Connect to partner *)
Listen - Listens on the port specified in the Port
property. Optionally advertise the 'ServerName' so
that clients can connect using name rather than
physical address.
example;
Sockets1.Listen; (* Establish server environment *)
Accept - Accepts a client request. Usually issued in
OnSessionAvailable event.
example;
Sock := NovTLI1.Accept; (* Get client connection *)
Close - Closes the connection.
example;
NovTLI1.Close; (* Close connection *)
Disconnect - Sends disconnect to partner
example;
NovTLI1.Disconnect;
Events: OnDataAvailable - Called when data is available to
be received from the partner. You should issue;
buffer := NovTLI1.Text; to receive the data from
the partner.
OnSessionAvailable - Called when a client has requested
to connect to a 'listening' server. You can call
the method Accept here.
OnSessionClosed - Called when the partner has closed
a connection on you. Normally, you would close your side
of the connection when this event happens.
OnSessionConnected - Called when the Connect has
completed and the session is connected. This is a
good place to send the initial data of a conversation.
Also, you may want to enable certain controls that
allow the user to send data on the conversation here.
}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, nwsap, nxtw, tiuser, tispxipx;
const
TLI_TYPE = $9000;
type
TDataAvailable = procedure (Sender: TObject; Socket: integer) of object;
TSessionClosed = procedure (Sender: TObject; Socket: integer) of object;
TSessionAvailable = procedure (Sender: TObject; Socket: integer) of object;
TSessionConnected = procedure (Sender: TObject; Socket: integer) of object;
TNovTLI = class(TWinControl)
private
FPort: integer;
FServerName: string;
FAddr: string;
FSocket: integer;
FLSocket: integer;
FTimer: integer;
spx_addr: IPX_ADDR;
spx_options: SPX_OPTS;
tbind: t_bindREC;
tcall: t_callREC;
discon: t_disconREC;
sap: SAP;
FDataAvailable: TDataAvailable;
FSessionClosed: TSessionClosed;
FSessionAvailable: TSessionAvailable;
FSessionConnected: TSessionConnected;
procedure SetText(Text: string);
function GetText : string;
procedure TWMPaint(var msg:TWMPaint); message WM_PAINT;
procedure TWMTimer(var msg:TWMTimer); message WM_TIMER;
function PutAddress(str: PChar; buf: PChar; hexBytes: integer) : integer;
function ParseAddress(addr: PChar; var destination: IPX_ADDR) : integer;
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect;
procedure Close;
procedure Listen;
procedure Disconnect;
procedure Accept;
property SocketNumber: integer read FSocket write FSocket;
property ListenSocketNumber: integer read FLSocket write FLSocket;
property Text: string read GetText write SetText;
published
property ServerName: string read FServerName write FServerName;
property Addr: string read FAddr write FAddr;
property Port: integer read FPort write FPort;
property OnDataAvailable: TDataAvailable read FDataAvailable
write FDataAvailable;
property OnSessionClosed: TSessionClosed read FSessionClosed
write FSessionClosed;
property OnSessionAvailable: TSessionAvailable read FSessionAvailable
write FSessionAvailable;
property OnSessionConnected: TSessionConnected read FSessionConnected
write FSessionConnected;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TNovTLI]);
end;
constructor TNovtli.Create(AOwner: TComponent);
var
iStatus: integer;
begin
inherited Create(AOwner);
FPort := 0;
FServerName := '';
FAddr := '';
FSocket := -1;
FLSocket := -1;
FTimer := 0;
Text := '';
Invalidate;
end;
destructor TNovtli.Destroy;
begin
if FSocket = -1 then
begin
t_close(FSocket);
FSocket := -1;
end;
if FLSocket = -1 then
begin
t_close(FLSocket);
FLSocket := -1;
end;
inherited Destroy;
end;
procedure TNovtli.TWMTimer(var msg: TWMTimer);
var
LookEvent: integer;
begin
if msg.TimerID = 100 then
begin
if (FSocket = -1) and (FLSocket = -1) then
exit;
if FSocket <> -1 then
begin
LookEvent := t_look(FSocket);
case LookEvent of
C_T_DATA:
begin
FDataAvailable(Self,FSocket);
end;
C_T_LISTEN:
begin
if t_listen(FSocket,@tcall) = -1 then
begin
t_close(FSocket);
t_error('Poll: t_listen failed');
exit;
end;
FSessionAvailable(Self,FSocket);
end;
C_T_DISCONNECT:
begin
if t_rcvdis(FSocket,nil) = -1 then
begin
t_close(FSocket);
t_error('Poll: t_rcvdis failed');
exit;
end;
FSessionClosed(Self,FSocket);
end;
C_T_CONNECT:
begin
if t_rcvconnect(FSocket,@tcall) = -1 then
begin
t_close(FSocket);
t_error('Poll: t_rcvconnect failed');
end;
FSessionConnected(Self,FSocket);
end;
end;
end;
if FLSocket <> -1 then
begin
LookEvent := t_look(FLSocket);
case LookEvent of
C_T_DATA:
begin
FDataAvailable(Self,FLSocket);
end;
C_T_LISTEN:
begin
if t_listen(FLSocket,@tcall) = -1 then
begin
t_close(FLSocket);
t_error('Poll: t_listen failed');
exit;
end;
FSessionAvailable(Self,FLSocket);
end;
C_T_DISCONNECT:
begin
if t_rcvdis(FLSocket,nil) = -1 then
begin
t_close(FLSocket);
t_error('Poll: t_rcvdis failed');
exit;
end;
FSessionClosed(Self,FLSocket);
end;
C_T_CONNECT:
begin
if t_rcvconnect(FLSocket,@tcall) = -1 then
begin
t_close(FLSocket);
t_error('Poll: t_rcvconnect failed');
exit;
end;
FSessionConnected(Self,FLSocket);
end;
end;
end;
end;
end;
procedure TNovtli.TWMPaint(var msg: TWMPaint);
var
icon: HIcon;
dc: HDC;
begin
if csDesigning in ComponentState then
begin
icon := LoadIcon(HInstance,MAKEINTRESOURCE('TNOVTLI'));
dc := GetDC(Handle);
Width := 32;
Height := 32;
DrawIcon(dc,0,0,icon);
ReleaseDC(Handle,dc);
FreeResource(icon);
end;
ValidateRect(Handle,nil);
end;
function TNovtli.PutAddress(str: PChar; buf: PChar; hexBytes: integer) : integer;
var
i,j,n,value: integer;
c: char;
begin
StrUpper(str);
n := 0;
for i:=0 to hexBytes-1 do
begin
value := 0;
for j:=0 to 1 do
begin
value := value shl 4;
if (str[n] >= '0') and (str[n] <= '9') then
value := value + ord(str[n]) - $30;
if (str[n] >= 'A') and (str[n] <= 'F') then
value := value + ord(str[n]) - $41 + 10;
inc(n);
end;
buf[i] := chr(value);
end;
PutAddress := 1;
end;
function TNovtli.ParseAddress(addr: PChar; var destination: IPX_ADDR) : integer;
begin
ParseAddress := 0;
if (StrLen(addr) = 21) and (addr[8] = '/') then
begin
if PutAddress(addr,destination.ipxa_net,4) = 1 then
if PutAddress(@addr[9],destination.ipxa_node,6) = 1 then
ParseAddress := 1;
end;
end;
procedure TNovtli.Connect;
var
ServerName: array[0..47] of char;
szAddr: array[0..25] of char;
i: integer;
begin
if FTimer = 0 then
FTimer := SetTimer(Handle,100,125,nil);
if FServerName <> '' then
begin
StrPCopy(ServerName,FServerName);
repeat
if QueryServices(1,TLI_TYPE,sizeof(SAP),sap) <> 0 then
break;
until ServerName = sap.ServerName;
if StrComp(ServerName,sap.ServerName) = 0 then
begin
spx_addr.ipxa_socket[0] := sap.Socket[0];
spx_addr.ipxa_socket[1] := sap.Socket[1];
for i:=0 to 3 do
spx_addr.ipxa_net[i] := sap.Network[i];
for i:=0 to 5 do
spx_addr.ipxa_node[i] := sap.Node[i];
end;
end
else
begin
strPCopy(szAddr,FAddr);
ParseAddress(szAddr,spx_addr);
spx_addr.ipxa_socket[0] := chr(FPort shr 8);
spx_addr.ipxa_socket[1] := chr(FPort and $ff);
end;
FSocket := t_open('/dev/nspx',O_RDWR or O_NDELAY, nil);
if FSocket = -1 then
t_error('Connect: t_open failed');
if t_bind(FSocket,nil,nil) = -1 then
t_error('Connect: t_bind failed');
tcall.addr.buf := @spx_addr;
tcall.addr.len := sizeof(spx_addr);
tcall.addr.maxlen := sizeof(spx_addr);
spx_options.spx_connectionID[0] := #0;
spx_options.spx_connectionID[1] := #0;
spx_options.spx_allocationNumber[0] := #0;
spx_options.spx_allocationNumber[1] := #0;
tcall.opt.buf := @spx_options;
tcall.opt.len := sizeof(spx_options);
tcall.opt.maxlen := sizeof(spx_options);
tcall.udata.buf := nil;
tcall.udata.len := 0;
tcall.udata.maxlen := 0;
t_connect(FSocket,@tcall,@tcall);
end;
procedure TNovtli.Accept;
begin
if FLSocket = -1 then
begin
Application.MessageBox('Accept: No open socket','NovTLI',MB_ICONEXCLAMATION);
exit;
end;
FSocket := t_open('/dev/nspx',O_RDWR or O_NDELAY,nil);
if FSocket = -1 then
t_error('Accept: t_open failed');
if t_bind(FSocket,nil,nil) = -1 then
begin
t_error('Accept: t_bind failed');
t_close(FSocket);
FSocket := -1;
end;
if t_accept(FLSocket,FSocket,@tcall) = -1 then
begin
t_error('Accept: t_accept failed');
t_close(FLSocket);
FSocket := -1;
end;
end;
procedure TNovtli.Close;
var
szServerName: array[0..31] of char;
begin
if FSocket <> -1 then
begin
t_close(FSocket);
if FSocket = FLSocket then
FLSocket := -1;
if FServerName <> '' then
begin
StrPCopy(szServerName,FServerName);
ShutdownSAP(szServerName);
end;
FSocket := -1;
end;
if (FSocket = -1) and (FLSocket = -1) then
if FTimer <> 0 then
begin
KillTimer(Handle,FTimer);
FTimer := -1;
end;
end;
procedure TNovtli.Disconnect;
begin
if FSocket <> -1 then
if t_snddis(FSocket,@tcall) = -1 then
t_error('Disconnect: t_snddis failed');
end;
procedure TNovtli.SetText(Text: string);
var
buf: array[0..256] of char;
begin
StrPCopy(buf,Text);
if not(csDesigning in ComponentState) and (FSocket <> -1) then
begin
if t_snd(FSocket,buf,length(Text),0) = -1 then
begin
t_error('Text (Set): t_snd failed');
t_close(FSocket);
FSocket := -1;
end;
end;
end;
procedure TNovtli.Listen;
var
szServerName: array[0..31] of char;
begin
if FTimer = 0 then
FTimer := SetTimer(Handle,100,125,nil);
if FPort = 0 then
Application.MessageBox('Port not specified, cannot listen','NovTLI',MB_ICONEXCLAMATION);
FLSocket := t_open('/dev/nspx',O_RDWR or O_NDELAY, nil);
if FLSocket = -1 then
t_error('Connect: t_open failed');
spx_addr.ipxa_socket[0] := chr(FPort shr 8);
spx_addr.ipxa_socket[1] := chr(FPort and $ff);
tbind.addr.len := sizeof(spx_addr);
tbind.addr.maxlen := sizeof(spx_addr);
tbind.addr.buf := @spx_addr;
tbind.qlen := 5;
if t_bind(FLSocket,@tbind,@tbind) = -1 then
t_error('Listen: t_bind failed');
tcall.addr.buf := @spx_addr;
tcall.addr.len := sizeof(spx_addr);
tcall.addr.maxlen := sizeof(spx_addr);
spx_options.spx_connectionID[0] := #0;
spx_options.spx_connectionID[1] := #0;
spx_options.spx_allocationNumber[0] := #0;
spx_options.spx_allocationNumber[1] := #0;
tcall.opt.buf := @spx_options;
tcall.opt.len := sizeof(spx_options);
tcall.opt.maxlen := sizeof(spx_options);
tcall.udata.buf := nil;
tcall.udata.len := 0;
tcall.udata.maxlen := 0;
if FServerName <> '' then
begin
StrPCopy(szServerName,FServerName);
AdvertiseService(TLI_TYPE,szServerName,FPort);
end;
end;
function TNovtli.GetText: string;
var
flags: integer;
buf: array[0..256] of char;
len: integer;
begin
flags := 0;
if FSocket <> -1 then
begin
if not(csDesigning in ComponentState) then
begin
len := t_rcv(FSocket,buf,sizeof(buf)-1,flags);
if len < 0 then
t_error('Text (Get): t_rcv failed');
buf[len] := #0;
GetText := StrPas(buf);
end;
end;
end;
end.